home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / textyl / psrc / textyl.pas.aa < prev    next >
Text File  |  1993-11-07  |  26KB  |  1,001 lines
  1.  
  2. (*$b0*)
  3.  
  4. program tyldvidvi(input,output);
  5. (* ----------------------------------------------------------
  6.         TeXtyl  line-drawing interface for TeX.
  7.           copyright (c) 1987 John S. Renner 
  8.               All rights reserved.
  9.         
  10. ABSTRACT: TeXtyl reads in a DVI file, and processes 'specials'
  11.         that refer to graphics capabilities that it knows about,
  12.         like line, spline, ThickThinSpline, and musical 
  13.         beams and slurs. TeXtyl then outputs a new DVI file, 
  14.         with the special-macros expanded and converted to 
  15.         DVI-commands for character setting.
  16.         
  17. DEPENDENCIES:  Few assumptions about Pascal are assumed. All
  18.         identifiers are unique to eight characters. There are
  19.         notes to indicate system-dependencies.
  20.         I assume the standard definition of "READ(fil, x)" to be
  21.         equivalent to "x := fil^; GET(fil)" , and
  22.         "WRITE(fil, x)" == "fil^ := x; PUT(fil)" .
  23.     Arrays are passed by reference (VAR) for efficiency.
  24.         See also the "sysdependent"  procedure; 
  25.         Problem areas, or areas for expansion are marked with ###
  26.  
  27. -------------------------------------------------------------*) 
  28. (* Revision History:
  29.     Jun. 1986  v1.0   Basic version of TeXtyl
  30.     Dec. 1986  v1.1   Added adaptive subdivision for spline
  31.                 interpolation. Added Cardinal basis.
  32.     Mar. 1987  v1.2   Added F and W flags for beginfigure
  33.             to allow required and/or actual dimensions
  34.                 to interface with files output by the
  35.             DP drawing program from Carnegie-Mellon
  36.             also various fixes
  37.     Apr. 1987  v1.3   Added linestyles (dotted, dashed, dotdashed)
  38.             
  39. *)
  40.  
  41. label
  42.     666, 30; 
  43. (*=====================CONST============================*)
  44. #include "tylext.h"
  45. #include "texpaths.h"
  46.  
  47. const
  48.   TylVersion = 'This is TeXtyl, Version 1.30';
  49.             (* for dvi-commands *)
  50.   PUT1         = 133;
  51.   SET1         = 128;
  52.   PUTRULE     = 137;
  53.   NOP         = 138;
  54.   PUSH         = 141;
  55.   POP         = 142;
  56.   RIGHTLEFT     = 143;
  57.   DOWNUP     = 157;
  58.   FONTDEF     = 244;
  59.   USEFONT     = 236; 
  60.   OURFONTFLAG     = 256; (* our special 'byte' value flag *)
  61.  
  62.   USESTDAREA = 0;    (* flag to use the 'standard' area to find .tfm files *)
  63.  
  64.         (* some conversions and numbers *)
  65.   SPPERPT     = 65536;   (* scaled points per printers point *)
  66.   SPPERMM     = 186468;  (* scaled pts per millimetre *)
  67.  
  68.   RADTODEG     = 57.29577952;     (* degrees per radian *)
  69.   DEGTORAD     = 0.0174532925; (* radians per degree *)
  70.   PI         = 3.141592654;
  71.  
  72.   TWO16 =      65536;     (* 2 ^ 16 *)
  73.   TWO20 =    1048576;    (* 2 ^ 20 *)
  74.   TWO23 =    8388608;
  75.   TWO24 =   16777216;
  76.   TWO27 =  134217728;
  77.   TWO31 = 2147483647; (* 2^31 - 1 *)
  78.  
  79.   BIGREAL = 1.0e30;
  80.   MAXVECLENsp    = 262144; (*  Normal maximum length of longest
  81.                  *  vector-font character in scaled points
  82.                *)
  83.  (* Music Font dependent constants *)
  84.   DOTCHAR       = 127;   (* ascii number of char that is a dot *)
  85.   QNOTEGHUS     = 18.0;  (* MF: Global Horizontal Units for a Quarternote *)
  86.   QNOTEGVUS     = 16.0;  (* MF: Global Vertical units for a quarternote *)
  87.   GBMGHUS       = 12.0;  (* MF: horizontal units for a grace beam *)
  88.   GBMGVUS       = 9.0;
  89.  
  90.   BMSTART     = 0;  BMEND = 69;  (* indices for start/end of the beam chars *)
  91.   LOBM1       = 0;         (* indices for the regular beam chars that *)
  92.   HIBM1       = 34;         (*   are 1 quarternote long, and *)
  93.   LOBM1p5     = 35;         (*   for those that are 1.5 quarternotes long *)
  94.   HIBM1p5     = 69;
  95.   
  96.   GBMSTART     = 70; GBMEND = 105;  (* indices for the grace beams *)
  97.   LOGBMp5      = 70;            (* indices for grace beam chars that *)
  98.   HIGBMp5      = 87;        (* are 0.5 grace quarternote long, and *)
  99.   LOGBMp66     = 88;        (* 0.66 grace quarternotes long *)
  100.   HIGBMp66     = 105;
  101.  
  102.   LoVThick     = 1;        (* Bounds for Vector char thicknesses *)
  103.   HiVThick     = 13;
  104.  
  105.   SizVFontTable    = 39; (* size of the Vector Font Table *) { 3*HiVThick }
  106.   SizMFontTable    = 18;(* size of the Music Font Table *)
  107.   MAXLABELFONTS    = 5;
  108.   SizLFontTable = MAXLABELFONTS;  (* size of the Label Font Table *)
  109.  
  110.   MAXCTLPTS     = 63; (* max number of control points *)
  111.   MAXCTLPTSp3    = 66; (* max control points + 3 *)
  112.   ARRLIMIT      = 100;    (* limit for strings and other arrays *)
  113.   MAXSPLINESEGS = 480;  (* max number of spline segments *)
  114.   MAXOLEN      = 128;    (* max length of Ostring that holds bytes of dvi cmds *)
  115.   MAXTBDs       = 50;    (* max number of Fonts-to-be-Defined *)
  116.  
  117.   MAXDVISTRINGS    = 600;    (* max number of DVI Ostrings per page *)
  118.   TFMSIZE     = 8000;    (* size of TFM array to hold .tfm file info *)
  119.   
  120.           (* Numeric names for the TeXtyl primitives *)
  121.   Aline         = 1; (* should be first *)
  122.   Aspline     = 2;
  123.   Attspline     = 3;
  124.   Abeam         = 4;
  125.   Atieslur     = 5;
  126.   Aarc         = 6;
  127.   Alabel     = 7;
  128.   Afigure     = 8; (* should be last one *)
  129.  
  130.   MAXFONTS     = 60;     (* number of TeX fonts to keep track of *)
  131.   STACKSIZE     = 50;     (* size of stack for pushes and pops *)
  132.   AREALENGTH     = TYLPATHLEN;  (* see also "sysdependent" proc for this value*)
  133.  
  134.   CR     = 13;    (* numbers of certain ascii characters  *)
  135.   LF     = 10;
  136.   HT     = 9;
  137.   FF     = 12;
  138.   ERRSIGNAL     = '?';
  139.   ERRNOTBAD    = 0;
  140.   ERRBAD     = 1;
  141.   ERRREALBAD    = 2;
  142.     
  143.  
  144.   READACCESS    = 4;
  145.   WRITEACCESS    = 2;
  146.   NOPATH    = 0;
  147.   FONTPATH    = 3;
  148.  
  149.  
  150.  
  151. (*===========================TYPES=============================*)
  152. type
  153.         (* ---- Bytes ---- *)
  154.  
  155.    Inbyt     = -128 .. 127;
  156.  
  157.    OctByt     = 0 .. 256;   (* DVI commands are 0..255, but we need
  158.                               one more for an internal flag *)
  159.    bytefile = packed file of Inbyt;
  160.  
  161.         (* ---- Strings ---- *)
  162.    asciicode     = 32 .. 126; 
  163.    charstring     = packed array [1 .. ARRLIMIT] of char;
  164.    ascstring     = packed array [1 .. ARRLIMIT] of asciicode;
  165.         (* rep for character strings *)
  166.    strng     = record 
  167.                 len: 0 .. ARRLIMIT;
  168.                 str:charstring;
  169.             end;
  170.         (* rep for ascii strings *)
  171.    astrng     = record 
  172.                 len: 0 .. ARRLIMIT;
  173.                 str: ascstring;
  174.             end; 
  175.         (* byte strings *)
  176.    pOstring     = ^Ostring;
  177.    Ostring      = packed array[1 .. MAXOLEN] of OctByt;
  178.  
  179.         (* ---- PUBLIC types ---- *)
  180.    VThickness     = LoVThick .. HiVThick;
  181.    VectKind       = (VKCirc, VKVert, VKHort);
  182.    BeamKind       = (regular, grace);
  183.    SplineKind     = (BSPL, INTBSPL, CATROM, CARD);
  184.    LineStyle    = (solid, dotted, dashed, dotdash);
  185.    ScaledPts      = integer;
  186.    MusIndex       = integer;
  187.    VecIndex       = integer;
  188.  
  189.    ThickAryType        = array[0 .. MAXSPLINESEGS] of VThickness;
  190.    SplineSegments     = array[1  ..  MAXSPLINESEGS, 1 .. 2] of ScaledPts;
  191.    ControlPoints      = array [0 .. MAXCTLPTSp3, 1 .. 2] of ScaledPts;
  192.  
  193.  
  194.         (* ----- Private Types ---- *)
  195.    FontInfRec = record
  196.                   Cht, Cdp, Cwd : ScaledPts;
  197.                   Angle : real;
  198.                   end;
  199.  
  200.    pVectFontInfRec    = ^VectFontInfRec;   (* vector font info *)
  201.    VectFontInfRec    = record
  202.               vkind : VectKind;
  203.               DesSize : ScaledPts;
  204.               PenSize : ScaledPts;
  205.               psize : VThickness;
  206.               MaxVectLen : ScaledPts;
  207.               FontName : strng;
  208.               Cksum : integer;
  209.               Isdefined : boolean;
  210.               DVIFontNum: integer;
  211.               FontInfo : array [0 .. 127] of FontInfRec;
  212.               end;
  213.  
  214.    pMusFontInfRec     = ^MusFontInfRec;    (* music font info *)
  215.    MusFontInfRec      = record
  216.               DesSize : ScaledPts;
  217.               Family : integer;
  218.               FontName : strng;
  219.               Cksum : integer;
  220.               Isdefined : boolean;
  221.               DVIFontNum: integer;
  222.               Staffsize : integer;
  223.               ghu : ScaledPts;
  224.               gvu : ScaledPts;
  225.               FontInfo : array [0 .. 127] of FontInfRec;
  226.               end;
  227.  
  228.    pLabFontInfRec    = ^LabFontInfRec;  (* label fonts info *)
  229.    LabFontInfRec    = record
  230.                  DesSize : ScaledPts;
  231.                  FontName : strng;
  232.               Cksum : integer;
  233.               Isdefined : boolean;
  234.               DVIFontNum : integer;
  235.               internalnumber : integer;
  236.               spacewidth : ScaledPts;
  237.               end;
  238.  
  239.  
  240.         (* list of dvi-strings *)
  241.    dvistary     = array[1 .. MAXDVISTRINGS] of pOstring;
  242.  
  243.    DVIBuftype     = record
  244.           TotByteLen : integer;
  245.           Numstrings : integer;
  246.           curstrindex : integer;
  247.           Dstrings : dvistary;
  248.           end;
  249.  
  250.         (* representation of list of fonts that have to be defined
  251.          *    before we output the BOP of the page we
  252.          *    just scanned 
  253.          *)
  254.    ToBeDefinedRec = record
  255.                     which : char; 
  256.                     indx : integer;
  257.                     end;
  258.  
  259.    stackrec = record 
  260.           sh, sv, sw, sx, sy, sz: integer;
  261.           end;
  262.  
  263.    Stacktype     = array [0 .. STACKSIZE] of stackrec;
  264.  
  265.    Oneby4Vector        = array[1 .. 4] of real;
  266.    Fourby4Matrix    = array[1 .. 4, 1 .. 4] of real;
  267.    Oneby5Vector        = array[1 .. 5] of real;
  268.    
  269.    Primitive = Aline .. Afigure;
  270.  
  271.    pItem    = ^Item;
  272.    figptr    = ^Figure;
  273.  
  274.    Item = packed record
  275.        nextitem : pItem;
  276.        BBlx, BBby, BBrx, BBty : ScaledPts; (* Bounding box *)
  277.        itemthick : VThickness;
  278.        itemvec : VectKind;
  279.        itempatt : LineStyle;
  280.        case kind : Primitive of
  281.            Aline : (    lx1, ly1, lx2, ly2 : ScaledPts;
  282.             );
  283.            Aspline : (    spltype : SplineKind;
  284.                 sclosed : boolean;
  285.                 dosmarks : integer;
  286.                 nsplknots : integer;
  287.                 spts : ControlPoints;
  288.               );
  289.            Attspline : (    tspltype : SplineKind;
  290.                 tclosed : boolean;
  291.                 dottmarks : integer;
  292.                 nttknots : integer;
  293.                 ttpts : ControlPoints;
  294.                 ttarry : ThickAryType;
  295.                 );
  296.            Abeam : (    bx1, by1, bx2, by2 : ScaledPts;
  297.                 staf : integer;
  298.                 bkind : BeamKind;
  299.             );
  300.            Atieslur : (    ntknots : integer;
  301.                 minth, maxth : VThickness;
  302.                 tspts : ControlPoints;
  303.                );
  304.            Aarc : (        acentx, acenty : ScaledPts;
  305.                 aradius : ScaledPts;
  306.                 firstang, lastang : integer;
  307.                 narcknots : integer;
  308.                 arcpts : ControlPoints;
  309.                );
  310.            Alabel : (    labx, laby : ScaledPts;
  311.                        fontstyle : integer;
  312.                 labeltext : strng;
  313.             );
  314.            Afigure : (    figtheta : real;
  315.                 fsx, fsy : real;
  316.                 fdx, fdy : ScaledPts;
  317.                 preWid, preHt : ScaledPts;
  318.                 postWid, postHt : ScaledPts;
  319.                 depthnumber : integer;
  320.                 body : figptr;
  321.               );
  322.           end;
  323.  
  324.    
  325.    Figure = record
  326.         things : pItem;
  327.         end;
  328.  
  329.  
  330. (*==============================VARS============================*)
  331. var
  332.    (* ----- Private vars *)
  333.     catrommtx : Fourby4Matrix;    (* basis matrix for catmul-rom splines*)
  334.     bsplmtx : Fourby4Matrix;    (* basis matrix for B-splines *)
  335.     cardmtx : Fourby4Matrix;    (* Cardinal spline matrix *)
  336.     lastPoint : integer;    (* num of output points *)
  337.     intervals : integer;    (* count of spline interval we are on *)
  338.     ourxpos,            (* internal x-position on page *)
  339.     ourypos,             (* internal y-position on page *)
  340.     ourfontnum : integer;    (* internal number of TeX font currently in use*)
  341.     ourpushdepth : integer;    (* depth of internal pushes *)
  342.     origTexfont : integer;    (* number of TeX font in use before tyling *)
  343.  
  344.     GDVIBuf : DVIBuftype;    (* Global DVI buffer that contains a list of
  345.                      * dvi commands for this page. All dvi-cmds
  346.                  * parsed are put here and possibly modified
  347.                  * before being written  to the output file
  348.                  *)
  349.  
  350.     VFontTable : array [1 .. SizVFontTable] of pVectFontInfRec;
  351.     MFontTable : array [1 .. SizMFontTable] of pMusFontInfRec;
  352.     LFontTable : array [1 .. SizLFontTable] of pLabFontInfRec;
  353.     (* the font tables, and the number of fonts defined in each *)
  354.     VFontsDefd, 
  355.     MFontsDefd,
  356.     LFontsDefd : integer;
  357.  
  358.     GDVIFN : integer;           (* dvi font number currently in use *)
  359.  
  360.             (* table of fonts yet  To-Be-Defined *)
  361.     TBD : array[1 .. MAXTBDs] of  ToBeDefinedRec;
  362.     FTBDs : integer;              (* number of fonts to be defined for current page *)
  363.  
  364.     pageitems : pItem;  (* list of primitives in current use in the current
  365.                  * figure on the current page
  366.              *)
  367.  
  368.     TotBytesWritten : integer; 
  369.     ourq : integer; (* the 'q' for the postpost *)
  370.     specstart: integer;        (* the place in the DVI buffer where the
  371.                      * start of the special begins.
  372.                  * this is so that we know how far to back up
  373.                  * and over-write the old \special macro string
  374.                  * with the cmds of our 'macro-expansion'
  375.                  *)
  376.  
  377.     multifigure : integer;    (* depth of definition recursion of figures *)
  378.     didnewfonts : boolean;    (* did we define the new fonts for this page? *)
  379.     prevfont : integer;        (* to keep track of prev font before the
  380.                      * PUSH and expansion of the special
  381.                  *)
  382.  
  383.     pgfigurenum : integer;    (* figure number for this page *)
  384.     currpagenum : integer;    (* number of page we are on *)
  385.     skiptsclamp : boolean;    (* DEBUG: should we skip post-clamping ties *)
  386.     dviBBlx, dviBBrx,         (* Bounding box of figure in DVI space *)
  387.     dviBBby, dviBBty : ScaledPts;
  388.     ErrorOccurred : boolean;    (* global flag in case some error happened *)
  389.  
  390.  
  391.     thefilename, realnameoffile : charstring; (* used externally *)
  392.  
  393.   (* ----- End private vars *)
  394.  
  395.  
  396.     tfmbyte : Inbyt;
  397.  
  398.     vaxbyt : Inbyt;
  399.  
  400.     tfm: array[-100 .. TFMSIZE] of OctByt;
  401.  
  402.     xord: array [char] of asciicode;
  403.     xchr: array [0 .. 255] of char;
  404.     outname: strng;    (* name of output file *)
  405.     tfmname : strng;    (* name of a .tfm file *)
  406.     dvifname : strng;    (* name of the input dvi file *)
  407.     logfilnam: strng;    (* name of the log file *)
  408.  
  409.     dvifile: bytefile;    
  410.     tfmfile: bytefile;
  411.     outputfil: bytefile;
  412.     logfile : text;
  413.  
  414.     curfont: integer;
  415.     s : 0 .. STACKSIZE;
  416.     h, v, w, x, y, z: integer;
  417.     stack: Stacktype;
  418.  
  419.     font: array [0 .. MAXFONTS] of 
  420.         record 
  421.             num: integer;
  422.             name: astrng;
  423.             checksum: integer;
  424.             scaledsize: integer;
  425.             designsize: integer;
  426.             space: integer;
  427.             bc: integer;
  428.             ec: integer;
  429.             widths: array [0 .. 127] of ScaledPts
  430.         end;
  431.     nf : 0 .. MAXFONTS; 
  432.  
  433.     MINREAL : real;     (* a system-dependent 'constant' *)
  434.     b0, b1, b2, b3: OctByt; 
  435.     inwidth: array [0 .. 255] of integer;
  436.     tfmchecksum: integer; 
  437.     conv: real;
  438.     trueconv: real; 
  439.     numerator, 
  440.     denominator: integer;
  441.     defaultdirectory: strng;
  442.     mag, 
  443.     magfactor: real; 
  444.     maxv, maxh, maxs : integer;
  445.     maxpages, 
  446.     totalpages : integer;
  447.     resolution: real;
  448.     inpostamble : boolean;
  449.     newbackptr, 
  450.     oldbackptr : integer;    
  451.     p, k : integer;
  452.     waste : integer;
  453.         
  454.  
  455. (* ==================forward declarations============================ *)
  456.  
  457. {  These hooks assume that the parameters are filled "correctly",
  458.     and are already transformed into 4th Quadrant DVI-space    }
  459.  
  460.  
  461. procedure TylTieSlur (var KnotArray: ControlPoints; 
  462.                       numknots: integer;
  463.                       minthick, maxthick: VThickness); forward;
  464.  
  465. procedure TylThickThinSpline (thetype : SplineKind; 
  466.               isclosed : boolean;
  467.                           var KnotArray: ControlPoints; 
  468.                           var ThikThinAry: ThickAryType;
  469.                           numknots: integer;
  470.                           vec: VectKind;
  471.               patt: LineStyle;
  472.               domarks : integer); forward;
  473.  
  474. procedure TylSpline (thetype : SplineKind; 
  475.               isclosed : boolean;
  476.                       var KnotArray: ControlPoints; 
  477.               numknots: integer;
  478.                       thick: VThickness; 
  479.               vec: VectKind;
  480.               patt: LineStyle;
  481.               domarks : integer); forward;
  482.  
  483. procedure TylLine (xl, yb, xr, yt: ScaledPts; 
  484.                      thickness: VThickness; 
  485.              vec: VectKind;
  486.              patt: LineStyle); forward;
  487.  
  488. procedure TylBeam (fromx, fromy, tox, toy: ScaledPts;
  489.                  staffsize : integer; 
  490.              kind : BeamKind); forward;
  491.  
  492. procedure TylArc (radius : ScaledPts; 
  493.           centx, centy : ScaledPts;
  494.           firstangle, secondangle : integer;
  495.           thick : VThickness; 
  496.           vec : VectKind;
  497.           patt: LineStyle); forward;
  498.  
  499. procedure TylLabel (xpos, ypos : ScaledPts;
  500.             fontstyle : integer;
  501.             phrase : charstring;
  502.             phraselen : integer); forward;
  503.  
  504. (*  private procedures *)
  505. procedure definebeams (var M : pMusFontInfRec); forward;
  506. procedure definevectors (var Vec: pVectFontInfRec); forward;
  507. procedure defineNewfonts; forward;
  508. procedure doTylArc (iscircle : boolean; var apts : ControlPoints;
  509.             numknots : integer; thick : VThickness; 
  510.             vec : VectKind; patt : LineStyle); forward;
  511. procedure strcopy (src : charstring; var dest : charstring; 
  512.             len : integer); forward;
  513. procedure writestrng (s :strng; tologfile : boolean); forward;
  514. (* end private procs *)
  515.  
  516. {------------------------------------------------------}
  517. procedure jumpout;
  518. begin
  519.     goto 666; (* global label *)
  520. end; 
  521.  
  522.  
  523. (*-------------- System Dependent stuff ----------------------*)
  524. (*  the default-directory should be where the .tfm files are 
  525.  *  to be found. the string len should reflect this name.
  526.  *  Check with the local site maintainer about any necessary
  527.  *  additions to the reset and rewrite procedures for opening
  528.  *  8-bit binary files.
  529.  *)
  530.  
  531.  
  532.  
  533.  
  534.  
  535. procedure sysdependent;
  536.  begin
  537.  
  538.  
  539.     setpaths;
  540.  
  541.     defaultdirectory.str := TYLPATH;
  542.     defaultdirectory.len := TYLPATHLEN; (* AREALENGTH const should be this, too *)
  543.     writeln(TylVersion,' for Berkeley Unix');
  544.  
  545.     resolution := 300.0; (* just a number *)
  546.     MINREAL := 1.0e-20;  (* so that we avoid some underflows *)
  547.  end;
  548.  
  549. {------------------------------------------------------------}
  550. procedure complain (severity :integer);
  551. begin
  552.  writeln(logfile,'Error in fig#',pgfigurenum:0,' on page ',currpagenum:0);
  553.  case severity of
  554.    ERRNOTBAD : begin
  555.            write (ERRSIGNAL);
  556.            end;
  557.    ERRBAD : begin
  558.            write (ERRSIGNAL);
  559.                 ErrorOccurred := true;
  560.            end;
  561.    ERRREALBAD : begin
  562.              write (ERRSIGNAL,'! ');
  563.                 ErrorOccurred := true;
  564.            end;
  565.               
  566.   end; (* case *)
  567. end;
  568.  
  569. function opendvifile : boolean;
  570. begin
  571.  
  572.     strcopy (dvifname.str, thefilename, dvifname.len);
  573.     thefilename[dvifname.len + 1] := ' ';
  574.     if (testaccess (READACCESS, NOPATH)) then
  575.       begin
  576.       reset (dvifile, realnameoffile);
  577.       opendvifile := true;
  578.       end
  579.     else
  580.       begin
  581.       writestrng(dvifname, false);
  582.       writeln(' : DVI file not found/readable ');
  583.       opendvifile := false;
  584.       end;  
  585.  
  586. end;
  587.  
  588. function opentfmfile : boolean;
  589. begin
  590.  
  591.   strcopy (tfmname.str, thefilename, tfmname.len);
  592.   thefilename[tfmname.len + 1] := ' ';
  593.   if (testaccess (READACCESS, FONTPATH)) then
  594.     begin
  595.     reset(tfmfile, realnameoffile);
  596.     opentfmfile := true;
  597.     end
  598.   else
  599.     begin
  600.     writestrng(tfmname, false);
  601.     writeln(' : TFM file not fount/readable ');
  602.     opentfmfile := false;
  603.     end;
  604.  
  605. end;
  606.  
  607. procedure openoutputfile;
  608. begin
  609.  
  610.   strcopy (outname.str, thefilename, outname.len);
  611.   thefilename[outname.len + 1] := ' ';
  612.   if (testaccess (WRITEACCESS, NOPATH)) then
  613.     rewrite (outputfil, realnameoffile)
  614.   else
  615.     begin
  616.     writestrng(outname, false);
  617.     writeln(' : Output file not writable');
  618.     jumpout;
  619.     end;
  620.  
  621. end;  
  622.  
  623. procedure openlogfile;
  624. begin
  625.  
  626.   strcopy (logfilnam.str, thefilename, logfilnam.len);
  627.   thefilename[logfilnam.len + 1] := ' ';
  628.   if (testaccess (WRITEACCESS, NOPATH)) then
  629.     rewrite (logfile, realnameoffile)
  630.   else
  631.     begin
  632.     writestrng(logfilnam, false);
  633.     writeln(' : Log file not writable');
  634.     jumpout;
  635.     end;
  636.  
  637. end;
  638.  
  639.  
  640. (* &&Module Tylsupport *)
  641.  
  642.  
  643. {---------------------------------------------------}
  644. procedure ClearBufString (var s : pOstring);
  645. (* clear a DVI buffer string  to contain no-ops*)
  646. var i : integer;
  647. begin
  648.   for i := 1 to MAXOLEN do
  649.     s^[i] := NOP;
  650. end;
  651.  
  652. {---------------------------------------------------}
  653. function NewBufString : pOstring;
  654. var s : pOstring;
  655. begin
  656.  new (s);
  657.  ClearBufString (s);
  658.  NewBufString := s;
  659. end;
  660.  
  661.  
  662.  
  663. (* NOTATION::
  664.  *       All procedures that put a dvi-command into the
  665.  *  temporary buffer are prefixed with "cmd"...
  666.  *       Functions that deal with reading .tfm files are prefixed
  667.  *  with "T" or have "tfm" in their names.       
  668.  *       Functions that deal with reading DVI files are
  669.  *  prefixed with a "D". 
  670.  *)
  671.  
  672. {--------------------------------------------}
  673. procedure cmd1byte (cmd : OctByt);
  674. begin
  675.   with GDVIBuf do
  676.     begin
  677.     if (Numstrings > MAXDVISTRINGS) then (* buffer full *)
  678.       begin
  679.       complain (ERRREALBAD);
  680.       writeln (logfile,'error: too many dvistrings. Totbytes = ',TotByteLen);
  681.       jumpout;
  682.       end;
  683.     if (curstrindex > MAXOLEN) then  (* current string full *)
  684.       begin
  685.       Numstrings := Numstrings + 1;
  686.       if (Dstrings[Numstrings] <> nil) then
  687.          dispose (Dstrings[Numstrings]);
  688.       Dstrings[Numstrings] := NewBufString;
  689.       ClearBufString(Dstrings[Numstrings]);
  690.       curstrindex := 1;
  691.       end;
  692.     Dstrings[Numstrings]^[curstrindex] := cmd; (* insert command byte *)
  693.     TotByteLen := TotByteLen + 1;
  694.     curstrindex := curstrindex + 1;
  695.     end;
  696. end;
  697.       
  698.  
  699. {---------------------------------------------------}
  700. procedure cmd2byte (cmd : integer);
  701. begin
  702.   cmd1byte (cmd div 256);
  703.   cmd1byte (cmd mod 256);
  704. end;
  705.  
  706. {---------------------------------------------------}
  707. procedure cmd3byte (cmd : integer);
  708. begin
  709.   cmd1byte (cmd div TWO16);
  710.   cmd1byte ((cmd div 256) mod 256);
  711.   cmd1byte (cmd mod 256);
  712. end;  
  713.  
  714. {---------------------------------------------------}
  715. procedure cmd4byte (cmd : integer);
  716. var tmp : integer;
  717. begin
  718.   tmp := cmd;
  719.   if (tmp >= 0) then
  720.     begin
  721.     cmd1byte (tmp div TWO24);
  722.     end
  723.   else
  724.     begin
  725.     tmp := tmp + TWO31 + 1; (* need the +1 *)
  726.     cmd1byte (tmp div TWO24 + 128);
  727.     end; 
  728.   tmp := tmp mod TWO24;
  729.   cmd1byte (tmp div TWO16);
  730.   tmp := tmp mod TWO16;
  731.   cmd1byte (tmp div 256);
  732.   cmd1byte (tmp mod 256);
  733. end;
  734.  
  735. {---------------------------------------------------}
  736. (* ### may be system dependent as integers are assumed 
  737.    to be signed 32-bits *)
  738.  
  739. procedure cmdSigned (i : integer; numbytes: integer);
  740. var tmp : integer;
  741. begin
  742.   if (numbytes = 4) then
  743.     cmd4byte (i)
  744.   else
  745.     begin     (* <= 3 bytes *)
  746.     tmp := i;
  747.     if (numbytes = 3) then
  748.       begin
  749.       if (tmp < 0) then
  750.         tmp := tmp + TWO24;
  751.       cmd1byte (tmp div TWO16);
  752.       tmp := tmp mod TWO16;
  753.       cmd1byte (tmp div 256);
  754.       end;
  755.     if (numbytes = 2) then
  756.       begin
  757.       if (tmp < 0) then
  758.     tmp := tmp + TWO16;
  759.       cmd1byte (tmp div 256);
  760.       end;  
  761.     if (numbytes = 1) then
  762.       begin
  763.       if (tmp < 0) then
  764.         tmp := tmp + 256;
  765.       end;
  766.     cmd1byte (tmp mod 256); (* for all *)
  767.     end;
  768. end;
  769.  
  770.  
  771.  
  772. {---------------------------------------------------}
  773. function Tgetvaxbyte : OctByt;
  774. label 9999;
  775. begin
  776.   tfmbyte := tfmfile^;
  777.   if (tfmbyte < 0) then
  778.     Tgetvaxbyte := tfmbyte + 256
  779.   else 
  780.     Tgetvaxbyte := tfmbyte;
  781.   if (eof (tfmfile)) then
  782.     begin
  783.     complain (ERRREALBAD);
  784.     writeln (logfile,' early EOF of tfm file! ');
  785.     goto 9999;
  786.     end;
  787.   get (tfmfile);
  788. 9999:       
  789. end;
  790.  
  791.  
  792. {---------------------------------------------------}
  793. procedure readtfmword;
  794.  
  795. begin
  796.  
  797.   b0 := Tgetvaxbyte;
  798.   b1 := Tgetvaxbyte;
  799.   b2 := Tgetvaxbyte;
  800.   b3 := Tgetvaxbyte;
  801.  
  802. end; 
  803.  
  804.  
  805. {---------------------------------------------------}
  806. function DVaxByte : OctByt;
  807. label 99;
  808. begin
  809.   vaxbyt := dvifile^;
  810.   if (eof (dvifile)) then
  811.     begin
  812.     DVaxByte := 0;
  813.     goto 99;
  814.     end;
  815.   if (vaxbyt < 0) then
  816.     DVaxByte := vaxbyt + 256
  817.   else  
  818.     DVaxByte := vaxbyt;
  819.   get (dvifile);
  820. 99:     
  821. end;
  822.  
  823.  
  824.  
  825. {---------------------------------------------------}
  826. (* get a byte from the DVI file, but do not copy it into the DVIbuffer *)
  827. function Dgrabbyte : integer;
  828. var
  829.     b: OctByt;
  830. begin
  831.   if eof(dvifile) then 
  832.     Dgrabbyte := 0
  833.   else
  834.      begin
  835.  
  836.      b := DVaxByte;
  837.  
  838.      Dgrabbyte := b;
  839.      end;
  840. end;
  841.  
  842.  
  843. {---------------------------------------------------}
  844. function Dget1byte : integer;
  845. var
  846.     b: OctByt;
  847. begin
  848.     if eof(dvifile) then 
  849.     Dget1byte := 0
  850.     else
  851.      begin
  852.  
  853.      b := DVaxByte;
  854.  
  855.      Dget1byte := b
  856.     end;
  857.     cmd1byte(b);
  858. end;
  859.  
  860. {---------------------------------------------------}
  861. function Dsign1byte : integer;
  862. var
  863.     b: OctByt;
  864. begin
  865.  
  866.     b := DVaxByte;
  867.  
  868.     if b < 128 then 
  869.     Dsign1byte := b
  870.     else 
  871.     Dsign1byte := b - 256;
  872.     cmd1byte(b);
  873. end; 
  874.  
  875. {---------------------------------------------------}
  876. function Dget2byte : integer;
  877. var
  878.     a, b: OctByt;
  879. begin
  880.  
  881.     a := DVaxByte;
  882.     b := DVaxByte;
  883.  
  884.     Dget2byte := a * 256 + b;
  885.     cmd1byte(a);
  886.     cmd1byte(b);
  887. end;
  888.  
  889. {---------------------------------------------------}
  890. function Dsign2byte : integer;
  891. var
  892.     a, b: OctByt;
  893. begin
  894.  
  895.     a := DVaxByte;
  896.     b := DVaxByte;
  897.  
  898.     if a < 128 then 
  899.     Dsign2byte := a * 256 + b
  900.     else 
  901.     Dsign2byte := (a - 256) * 256 + b;
  902.     cmd1byte(a);
  903.     cmd1byte(b);
  904. end;
  905.  
  906. {---------------------------------------------------}
  907. function Dget3byte : integer;
  908. var
  909.     a, b, c: OctByt;
  910. begin
  911.  
  912.     a := DVaxByte;
  913.     b := DVaxByte;
  914.     c := DVaxByte;
  915.  
  916.     Dget3byte := (a * 256 + b) * 256 + c;
  917.     cmd1byte(a);
  918.     cmd1byte(b);
  919.     cmd1byte(c);
  920. end;
  921.  
  922. {---------------------------------------------------}
  923. function Dsign3byte : integer;
  924. var
  925.     a, b, c: OctByt;
  926. begin
  927.  
  928.     a := DVaxByte;
  929.     b := DVaxByte;
  930.     c := DVaxByte;
  931.  
  932.     if a < 128 then 
  933.     Dsign3byte := (a * 256 + b) * 256 + c
  934.     else 
  935.     Dsign3byte := ((a - 256) * 256 + b) * 256 + c;
  936.     cmd1byte(a);
  937.     cmd1byte(b);
  938.     cmd1byte(c);    
  939. end;
  940.  
  941. {---------------------------------------------------}
  942. function Dsign4byte : integer;
  943. var
  944.     a, b, c, d: OctByt;
  945. begin
  946.  
  947.     a := DVaxByte;
  948.     b := DVaxByte;
  949.     c := DVaxByte;
  950.     d := DVaxByte;
  951.  
  952.     if a < 128 then 
  953.     Dsign4byte := ((a * 256 + b) * 256 + c) * 256 + d
  954.     else 
  955.     Dsign4byte := (((a - 256) * 256 + b) * 256 + c) * 256 + d;
  956.     cmd1byte(a);
  957.     cmd1byte(b);
  958.     cmd1byte(c);
  959.     cmd1byte(d);    
  960. end;
  961.  
  962.  
  963. {---------------------------------------------------}
  964. (* write a byte out to the ouput file, but if we
  965.  * encounter the font flag, define the new fonts, and
  966.  * continue
  967.  *)
  968. procedure OutputByte (b : OctByt);
  969. var x : Inbyt;
  970.     n : integer;
  971. begin
  972.    n := b;
  973.    if (n = OURFONTFLAG) then
  974.      begin    (* our special macro-flag *)
  975.      n := NOP; (* nullify it *)
  976.      if (not didnewfonts) then
  977.        begin
  978.        didnewfonts := true;       
  979.        defineNewfonts; (* expand the defns in the outfile itself *)
  980.        end;
  981.      end;  (* if *)
  982.  
  983.     if (n > 127) then
  984.       begin
  985.       x := n - 256;
  986.       end
  987.     else
  988.       x := n;
  989.     outputfil^ := x;
  990.     put (outputfil);
  991.  
  992.   TotBytesWritten := TotBytesWritten + 1;  (* keep count of all bytes *)
  993. end;
  994.  
  995. {---------------------------------------------------} 
  996. procedure Output2Byte (i : integer);
  997. begin
  998.   OutputByte (i div 256);
  999.   OutputByte (i mod 256);
  1000. end;
  1001.